Celestin Apprentice 2/Apprentice-Release2.iso/Tools/Languages/Caml Light 0.61/Source/src/runtime/memory.c

C/C++ Source or Header | 1993-09-24 | 5.2 KB | 212 lines | [TEXT/MPS ]

#include "debugger.h"
#include "fail.h"
#include "freelist.h"
#include "gc.h"
#include "major_gc.h"
#include "memory.h"
#include "minor_gc.h"
#include "misc.h"
#include "mlvalues.h"

value *c_roots_head;

/* Allocate more memory from malloc for the heap.
   Return a block of at least the requested size (in words).
   Return NULL when out of memory.
*/
static char *expand_heap (request)
     mlsize_t request;
{
  char *mem;
  char *new_page_table;
  asize_t new_page_table_size;
  asize_t malloc_request;
  asize_t i, more_pages;

  malloc_request = round_heap_chunk_size (Bhsize_wosize (request));
  gc_message ("Growing heap to %ld kB.\n",
          (total_heap_size + malloc_request) / 1024);
  mem = aligned_malloc (malloc_request + sizeof (heap_chunk_head),
                        sizeof (heap_chunk_head));
  if (mem == NULL){
    gc_message ("No room.\n", 0);
    return NULL;
  }
  mem += sizeof (heap_chunk_head);
  (((heap_chunk_head *) mem) [-1]).size = malloc_request;
  Assert (Wosize_bhsize (malloc_request) >= request);
  Hd_hp (mem) = Make_header (Wosize_bhsize (malloc_request), 0, Blue);

#ifndef SIXTEEN
  if (mem < heap_start){
    more_pages = -Page (mem);  /* ### page numbers are unsigned ! */
  }else if (Page (mem + malloc_request) > page_table_size){
    Assert (mem >= heap_end);
    more_pages = Page (mem + malloc_request) - page_table_size;
  }else{
    more_pages = 0;
  }

  if (more_pages != 0){
    new_page_table_size = page_table_size + more_pages;
    new_page_table = (char *) malloc (new_page_table_size);
    if (new_page_table == NULL){
      gc_message ("no room.\n", 0);
      free (mem);
      return NULL;
    }
  }

  if (mem < heap_start){
    Assert (more_pages != 0);
    for (i = 0; i < more_pages; i++){
      new_page_table [i] = Not_in_heap;
    }
    bcopy (page_table, new_page_table + more_pages, page_table_size);
    (((heap_chunk_head *) mem) [-1]).next = heap_start;
    heap_start = mem;
  }else{
    char **last;
    char *cur;

    if (mem >= heap_end) heap_end = mem + malloc_request;
    if (more_pages != 0){
      for (i = page_table_size; i < new_page_table_size; i++){
        new_page_table [i] = Not_in_heap;
      }
      bcopy (page_table, new_page_table, page_table_size);
    }
    last = &heap_start;
    cur = *last;
    while (cur != NULL && cur < mem){
      last = &((((heap_chunk_head *) cur) [-1]).next);
      cur = *last;
    }
    (((heap_chunk_head *) mem) [-1]).next = cur;
    *last = mem;
  }

  if (more_pages != 0){
    free (page_table);
    page_table = new_page_table;
    page_table_size = new_page_table_size;
  }
#else                           /* Simplified version for the 8086 */
  {
    char **last;
    char *cur;

    last = &heap_start;
    cur = *last;
    while (cur != NULL && (char huge *) cur < (char huge *) mem){
      last = &((((heap_chunk_head *) cur) [-1]).next);
      cur = *last;
    }
    (((heap_chunk_head *) mem) [-1]).next = cur;
    *last = mem;
  }
#endif

  for (i = Page (mem); i < Page (mem + malloc_request); i++){
    page_table [i] = In_heap;
  }
  total_heap_size += malloc_request;
  return Bp_hp (mem);
}

value raw_alloc_shr (wosize, tag)
     mlsize_t wosize;
     tag_t tag;
{
  char *hp, *new_block;

  while (1){
    hp = fl_allocate (master_fl, wosize);
    if (hp != NULL) break;
    new_block = expand_heap (wosize);
    if (new_block == NULL) raise_out_of_memory ();
    fl_add_block (master_fl, new_block);
  }
  Assert (Is_in_heap (Val_hp (hp)));

  if (gc_phase == Phase_mark || (addr)hp >= (addr)gc_sweep_hp){
    Hd_hp (hp) = Make_header (wosize, tag, Black);
  }else{
    Hd_hp (hp) = Make_header (wosize, tag, White);
  }
  allocated_words += Whsize_wosize (wosize);
  return Val_hp (hp);
}

value alloc_shr (wosize, tag)
     mlsize_t wosize;
     tag_t tag;
{
  if (allocated_words > Wsize_bsize (young_end - young_start)) {
    minor_collection ();
  }
  return raw_alloc_shr (wosize, tag);
}

/* You must use [initialize] to store the initial value in a field of
   a shared block, unless you are sure the value is not a young block.
   A block value [v] is a shared block if and only if [Is_in_heap (v)]
   is true.
*/
/* [initialize] never calls the GC, so you may call it while an object is
   unfinished (i.e. just after a call to [alloc_shr].) */
void initialize (fp, val)
     value *fp;
     value val;
{
  *fp = val;
  Assert (Is_in_heap (fp));
  if (Is_block (val) && Is_young (val)){
    *ref_table_ptr++ = fp;
    if (ref_table_ptr >= ref_table_end){
      realloc_ref_table ();
    }
  }
}

/* You must use [modify] to change a field of an existing shared block,
   unless you are sure the value being overwritten is not a shared block and
   the value being written is not a young block. */
/* [modify] never calls the GC. */
void modify (fp, val)
     value *fp;
     value val;
{
  Modify (fp, val);
}

char * stat_alloc (sz)
     asize_t sz;
{
  char * result = (char *) malloc (sz);

  if (result == NULL) raise_out_of_memory ();
  return result;
}

void stat_free (blk)
     char * blk;
{
  free (blk);
}

char * stat_resize (blk, sz)
     char *blk;
     asize_t sz;
{
  return (char *) realloc (blk, sz);
}

void init_memory (generation_size, heap_size)
     asize_t generation_size, heap_size;
{
  init_minor_heap (generation_size);
  init_major_heap (heap_size);
  c_roots_head = NULL;
}